VERSION 5.00
Object = "{9BDD5DDA-8B5C-483F-8BD3-474F094E4D08}#1.0#0"; "RFSApp.ocx"
Begin VB.Form Form1 
   ClientHeight    =   2400
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5340
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   2400
   ScaleWidth      =   5340
   WindowState     =   1  'Minimized
   Begin RFSApplicationControl.RFSApplication RFSApplication1 
      Left            =   4440
      Top             =   1560
      _ExtentX        =   1085
      _ExtentY        =   1085
      Event_Demo      =   0   'False
      TrimSpaces      =   -1  'True
   End
   Begin VB.TextBox txtSite 
      Height          =   285
      Left            =   1680
      TabIndex        =   12
      Top             =   1920
      Width           =   2175
   End
   Begin VB.TextBox txtProcess 
      Height          =   285
      Left            =   1680
      TabIndex        =   11
      Top             =   1560
      Width           =   2175
   End
   Begin VB.TextBox txtCurrentScreen 
      Height          =   285
      Left            =   1680
      TabIndex        =   9
      Top             =   1200
      Width           =   2175
   End
   Begin VB.CommandButton cmdDrop 
      Caption         =   "<Disconnect>"
      Height          =   495
      Left            =   4080
      TabIndex        =   7
      Top             =   120
      Width           =   1095
   End
   Begin VB.TextBox txtStartDate 
      Height          =   285
      Left            =   1680
      TabIndex        =   6
      Top             =   840
      Width           =   2175
   End
   Begin VB.TextBox txtUser 
      Height          =   285
      Left            =   1680
      TabIndex        =   4
      Top             =   480
      Width           =   2175
   End
   Begin VB.TextBox txtIP 
      Height          =   285
      Left            =   1680
      TabIndex        =   1
      Top             =   120
      Width           =   2175
   End
   Begin VB.Label lblSite 
      Caption         =   "<Site>"
      Height          =   255
      Left            =   120
      TabIndex        =   13
      Top             =   1920
      Width           =   1335
   End
   Begin VB.Label lblCurrentAction 
      Caption         =   "<Process>"
      Height          =   255
      Left            =   120
      TabIndex        =   10
      Top             =   1560
      Width           =   1335
   End
   Begin VB.Label lblCurrentScreen 
      Caption         =   "<Current Screen>"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   1200
      Width           =   1335
   End
   Begin VB.Label lblStartDate 
      Caption         =   "<Start Date>"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label lblUser 
      Caption         =   "<User>"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   480
      Width           =   975
   End
   Begin VB.Label lblClientIP 
      Caption         =   "<Client IP>"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   855
   End
   Begin VB.Label IPLabel 
      Height          =   255
      Left            =   480
      TabIndex        =   0
      Top             =   1680
      Width           =   1935
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'user-level recordsets
Dim rsInvoices As ADODB.Recordset
Dim rsInvoiceItems As ADODB.Recordset
Dim rsInventory As ADODB.Recordset
Dim rsScanCount As ADODB.Recordset

Dim rsJob As ADODB.Recordset
Dim rsRecipe As ADODB.Recordset
Dim rsRaw As ADODB.Recordset
Dim rsRaw2 As ADODB.Recordset
Dim rsPhysical As ADODB.Recordset
Dim rsPhysicalNew As ADODB.Recordset
Dim rsRawDetail As ADODB.Recordset
Dim rsUserOption As ADODB.Recordset

'Shipping Variables
Dim InvoiceNum As String
Dim InvoiceItem As String
Dim ScanCount As String
'Dim Customer As String
Dim ProdCODE As String
Dim Weight As Double
Dim Lot As String
Dim WeightUsed As Double

'user-level variables
Dim strSite As String
Dim strBinLoc As String
Dim strUserName As String
Dim strPassword As String
Dim enAct As enActions
Dim CurrentScreen As enScreen
Dim hold As String

'Receiving Variables
Dim intJob As Long
Dim counter As Integer
Dim strUnitNum As String    'Used in Physical and Receiving
Dim strPO As String
Dim numPO As Integer
Dim strBF As String         'Used in Receiving and Periodic
Dim strSize As String       'Used in Receiving and Periodic
Dim strWideNum As String
Dim strLength As String
Dim strHighNum As String
Dim strBarcodeID As String
Dim strLine As String       'POLINENUMBER
Dim strRecAmt As String
Dim strProdCODE As String
Dim strTemp As String
Dim blFreshFroz As String
Dim blPests As String
Dim blSealed As String
Dim blDamaged As String
Dim strTrailCond As String
Dim strLOTnum As String
Dim numLOTnum As Integer
Dim strQty As String
Dim strVenLot As String
Dim blsuccess As Boolean
Dim strRECER As String
Dim strPH As String
Dim strBRIX As String
Dim dblLineValue As Double

'Shipping Variables
Dim vSONum As Integer

'Recipe variables
Dim strRecNum As String
Dim RecipeNum As Long
Dim recnamE As String
Dim ing  As Long       'ingredient array
Dim Con  As Double      'Consumed amount array
Dim vnd As String

Dim Y  As Integer
Dim JOBy As Integer
Dim strFGCaseLot As String
Dim strCaseNum As String
Dim strBotnCase As String
Dim vBottles As String
Dim strUPC As String


Private Sub DisplayScreen(ByRef buffer As String)
    On Error GoTo Errorhandler
    'Uncomment the following line to run this on a PC as the Yes/No questions do not work the same.
    'blnPC = True

    Me.RFSApplication1.RFClearScreen
    Me.RFSApplication1.RFInitializeScreen
    Me.RFSApplication1.RFCursorOn RFSApplication1.CURSOR_UNDERSCORE
    Me.txtCurrentScreen = GetCurrentScreen
    Me.txtProcess = GetAction
    Select Case CurrentScreen
        Case scsplash
            Call ScreenSplash(buffer)
        Case scLogin
            Call ScreenLogin(buffer)
        Case scMainMenu
            Call ScreenMainMenu(buffer)
        Case screceiving1
            Call ScreenReceiving1(buffer)
        Case screceivingLOT
            Call ScreenReceivingLOT(buffer)
        Case scReceiving2
            Call ScreenReceiving2(buffer)
        Case scReceiving3
            Call ScreenReceiving3(buffer)
        Case scReceiving5
            Call ScreenReceiving5(buffer)
        Case scReceiving5b
            Call ScreenReceiving5b(buffer)
        Case scReceiving4b
            Call ScreenReceiving4b(buffer)
        Case scHAC
            Call ScreenHAC(buffer)
        Case scReceiving3b
            Call ScreenReceiving3b(buffer)
        Case scShipping                 'Enter Invoice Number
            Call ScreenShipping(buffer)
        Case scNoUser
            Call ScreenNoUser(buffer)
        Case scRecipe
            Call ScreenRecipe(buffer)
        Case scRecipe2
            Call ScreenRecipe2(buffer)
        Case scRecipe3
            Call Screenrecipe3(buffer)
        Case scJobNumber
            Call ScreenJobNumber(buffer)
        Case scConfirmation
            Call ScreenConfirmAtion(buffer)
        Case scFG1
            Call ScreenFG1(buffer)
        Case scConLot
            Call ScreenConLot(buffer)
        Case scConShip
            Call ScreenConship(buffer)
        Case scsuccess
            Call ScreenSuccess(buffer)
        Case scconsume1
            Call ScreenConsume1(buffer)
        Case scconsume2
            Call ScreenConsume2(buffer)
        Case scConsume3
            Call ScreenConsume3(buffer)
         
    End Select
    If buffer = "" Then
        Me.RFSApplication1.RFDisplay
        Me.RFSApplication1.RFEdit
    End If
buffer = ""
Exit Sub
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description
End Sub

Private Sub ScreenSplash(ByRef buffer As String)
Dim ctl1 As Control
Dim strRetKey As String
On Error GoTo Errorhandler
If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 1, 2, GetLabel("lblSplash1", rsRFSystemParameter!Language)
    Me.RFSApplication1.RFLabel 1, 3, GetLabel("lblSplash3", rsRFSystemParameter!Language)
    Me.RFSApplication1.RFLabel 1, 5, "Version " & App.Major & "." & App.Minor & "." & App.Revision
    Me.RFSApplication1.RFLabel 1, 7, GetLabel("lblEnter", rsRFSystemParameter!Language)
    Me.RFSApplication1.RFLabel 1, 8, GetLabel("lblEscToDos", rsRFSystemParameter!Language)
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 9, 0, "", "", ""
    For Each ctl1 In Me.Controls
        If TypeOf ctl1 Is TextBox Then
            If ctl1.Name <> txtIP.Name Then
                ctl1.Text = ""
            End If
        End If
    Next
Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
        Case RF_F5
            Me.RFSApplication1.RFEnd
        Case RF_ENTER
            CurrentScreen = scLogin
    End Select
End If
Exit Sub
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description

End Sub

Private Sub ScreenLogin(ByRef buffer As String)
On Error GoTo Errorhandler
    
    Dim linevar As Integer
    Dim strRetKey As String
    Dim rsX As New ADODB.Recordset
    Dim HoldPsswd As String
    linevar = 1

ResetModuleVariables
linevar = linevar + 1
CloseModuleRecordsets

Set rsUsers = New ADODB.Recordset
rsUsers.Open "Select * from UserIDs", MDIForm1.dc.conReadOnly, adOpenKeyset, adLockReadOnly

strUserName = ""

If buffer = "" Then

    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 1, 1, GetLabel("lblUserID", rsRFSystemParameter!Language)
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 2, 50, "", "", ""
    Me.RFSApplication1.RFLabel 1, 3, "Password"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 4, 50, "", "", ""
   
Else

    strRetKey = ParseBuffer(1, buffer)
    
    Select Case strRetKey
      Case RF_ENTER
            strUserName = ParseBuffer(2, buffer)
            strPassword = ParseBuffer(3, buffer)
            rsUsers.MoveLast
            rsUsers.MoveFirst
            rsUsers.Find "UserID='" & strUserName & "'"
            If strUserName = "" Then
                CurrentScreen = scNoUser
                blsuccess = False
                LOGTIME
                Exit Sub
            End If
            If rsUsers.EOF = True Then
                CurrentScreen = scNoUser
                blsuccess = False
                LOGTIME
                Exit Sub
            End If
            
               CloseModuleRecordsets
                Set rsUsers = New ADODB.Recordset
                rsUsers.Open "Select * from UserIDs where UserID ='" & strUserName & "'", MDIForm1.dc.conReadOnly, adOpenKeyset, adLockReadOnly
                rsUsers.Find "Password ='" & strPassword & "'"
                If strPassword = "" Then
                    CurrentScreen = scNoUser
                    blsuccess = False
                    LOGTIME
                    Exit Sub
                End If
                If rsUsers.EOF Then
                    CurrentScreen = scNoUser
                    blsuccess = False
                    LOGTIME
                    Exit Sub
                End If
                appUser = strUserName
                CurrentScreen = scMainMenu
                CloseModuleRecordsets
                blsuccess = True
                LOGTIME
                Exit Sub
           
        Case RF_F5
            CurrentScreen = scsplash
    End Select
End If
Exit Sub
Errorhandler:
    MsgBox "Line error occured: " & linevar
    LogError buffer, Err.Number, Err.Source, Err.Description
End Sub

Private Sub LOGTIME()
Set rsUsers = New ADODB.Recordset
rsUsers.Open "tblLOG", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic
rsUsers.AddNew
rsUsers!User = strUserName
rsUsers!Date = Now
rsUsers!Success = blsuccess
rsUsers.Update
CloseModuleRecordsets

End Sub

Private Sub ScreenNoUser(ByVal buffer As String)
Dim strRetKey As String

If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER
    Me.RFSApplication1.RFLabel 1, 1, "Wrong User or "
    Me.RFSApplication1.RFLabel 1, 2, "Password...."
    Me.RFSApplication1.RFLabel 1, 4, "Enter to Go Back."
Else
    strRetKey = ParseBuffer(1, buffer)
    If strRetKey = RF_ENTER Then
        CurrentScreen = scLogin
    Else
        CurrentScreen = scsplash
    End If
End If
Exit Sub

End Sub

Private Sub ScreenMainMenu(ByRef buffer As String)
    On Error GoTo Errorhandler
Dim strRetKey As String
ResetModuleVariables
CloseModuleRecordsets

If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_F5 & RF_F1 & RF_F2 & RF_F3 & RF_F4 '& RF_F5
    Me.RFSApplication1.RFLabel 1, 1, GetLabel("lblF1=Receiving", rsUserOption!Language)
    Me.RFSApplication1.RFLabel 1, 2, GetLabel("lblF2=Shipping", rsUserOption!Language)
    Me.RFSApplication1.RFLabel 1, 3, GetLabel("lblRecipe", rsUserOption!Language)
    Me.RFSApplication1.RFLabel 1, 4, GetLabel("lblFG", rsUserOption!Language)
    'Me.RFSApplication1.RFLabel 1, 5, GetLabel("lblF3=PhysInv", rsUserOption!Language)
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 7, 0, "", "", ""
    
    Me.RFSApplication1.RFDisplay
    
Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
        Case RF_F5
            CurrentScreen = scLogin
            strUserName = ""
        Case RF_F1
            CurrentScreen = screceiving1
        Case RF_F2
            CurrentScreen = scShipping
        Case RF_F3
            CurrentScreen = scconsume1  'Changed
            'CurrentScreen = scRecipe
        Case RF_F4
            CurrentScreen = scFG1
    End Select
End If
Exit Sub
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description

End Sub


Private Sub cmdDrop_Click()
    On Error Resume Next
    If Me.RFSApplication1.SessionState <> 0 Then
        Me.RFSApplication1.RFInformation GetMessage("msgDisconnected")
        Me.RFSApplication1.SessionClose
        RFSApplication1_SessionClosed
    End If
End Sub

Private Sub Form_Initialize()
    Dim ctl1 As Control
End Sub

Private Sub Form_Load()
Dim ctl1 As Control
Dim strTemp As String
For Each ctl1 In Me.Controls
    If TypeOf ctl1 Is TextBox Then
        ctl1.Enabled = False
    End If
    If TypeOf ctl1 Is Label Or TypeOf ctl1 Is CommandButton Then
        strTemp = GetLabel(ctl1.Name)
        If strTemp <> "" Then ctl1.Caption = strTemp
    End If
Next
    Me.IPLabel.Visible = False
    Me.Height = 2640
    Me.Width = 5355
    Me.Tag = Me.Tag & "Loaded"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    CloseRS rsUserOption
    Me.RFSApplication1.SessionClose
    Me.Tag = ""
End Sub


Private Sub RFSApplication1_DataReceivedFromClient(SessionData As String)
    Call DisplayScreen(SessionData)
    If Me.RFSApplication1.SessionState = sckConnected Then
        Call DisplayScreen("")
    End If

End Sub

Private Sub RFSApplication1_DataReceivedFromClientBad(SessionData As String)

If Me.RFSApplication1.SessionState = sckConnected Then
    MsgBox "buffer", vbOKCancel
    
End If

End Sub

Private Sub RFSApplication1_SessionClosed()
Dim ctl1 As Control
    Me.Caption = ""
    Me.IPLabel.Caption = ""
    Me.RFSApplication1.SessionClose

    For Each ctl1 In Me.Controls
    If TypeOf ctl1 Is TextBox Then
        ctl1.Text = ""
    End If
    Next
    CloseRS rsUserOption
    MDIForm1.SetIconTip
End Sub

Private Sub RFSApplication1_SessionError(ByVal Number As Integer, Description As String)
    Select Case Number
    Case 10048, 10052, 10053, 10054
        Call RFSApplication1_SessionClosed
    Case Else
        LogError Trim(Str(Number)) & "-" & Description
    End Select
End Sub

Private Sub RFSApplication1_SessionOpened()

    OpenRecordsets
    CurrentScreen = scsplash
    Me.IPLabel.Visible = False
    Me.RFSApplication1.RFSetRows 8
    Call DisplayScreen("")

End Sub

Private Function ParseBuffer(pintToken As Integer, pstrBuffer As String)
    If rsRFSystemParameter!ConvertToUpperCase Then
        ParseBuffer = UCase(Me.RFSApplication1.RFSessionParseBuffer(pintToken, pstrBuffer))
    Else
        ParseBuffer = Me.RFSApplication1.RFSessionParseBuffer(pintToken, pstrBuffer)
    End If
End Function

Private Function OpenRecordsets() As Boolean
    If rsUserOption Is Nothing Then
        Set rsUserOption = New ADODB.Recordset
    End If
    If rsUserOption.State <> 1 Then
        rsUserOption.Open "RFUserOption", conLocal, adOpenKeyset, adLockReadOnly
    End If
    
End Function

Private Sub ResetModuleVariables()
    strUnitNum = ""
    strPO = ""
    strBF = ""
    strSize = ""
    strWideNum = ""
    strLength = ""
    strHighNum = ""
    'strPerTag = ""
    'strItem = ""
    'strSpc = ""
    
End Sub
Private Sub ResetModuleVariables2()
    strUnitNum = ""
    strBF = ""
    strSize = ""
    strWideNum = ""
    strLength = ""
    strHighNum = ""
    InvoiceNum = ""
    InvoiceItem = ""
    ScanCount = ""
    'Customer = ""
    ProdCODE = ""
    Weight = 0
    Lot = ""
    WeightUsed = 0
    
End Sub
Private Sub CloseModuleRecordsets()
    CloseRS rsInvoices
    CloseRS rsInvoiceItems
    CloseRS rsInventory
    CloseRS rsScanCount
    
    CloseRS rsRecipe
    CloseRS rsRaw
    CloseRS rsPhysical
    CloseRS rsPhysicalNew
    CloseRS rsRawDetail
    CloseRS rsRaw2
    CloseRS rsUsers
    
    CloseRS rsJob
       
End Sub
Private Sub CloseVars()

'ing = ""
'Con = ""

End Sub

Private Sub LogError(buffer As String, Optional pErrNo As Long = 0, Optional pErrSrc As String = "", Optional pErrDesc As String = "")
    Dim intHandle As Integer
    Dim X As Integer
    On Error Resume Next
    'If Err.Number = 0 Then Exit Sub
    Me.RFSApplication1.RFInformation pErrDesc
    'alert user
    intHandle = FreeFile
    Open DataLoc & "\error.log" For Append As #intHandle
    'Print #intHandle, "ERROR"
    Print #intHandle, MDIForm1.Caption
    Print #intHandle, "Date/Time:" & Format(Now, "mm/dd/yyyy hh:mm:ss")
    Print #intHandle, "UserID:" & strUserName
    Print #intHandle, "Client: " & Me.txtIP.Text
    Print #intHandle, "Current Action: " & GetAction
    Print #intHandle, "Last screen:" & GetCurrentScreen
    Print #intHandle, "Error Number:" & IIf(pErrNo > 0, pErrNo, Err.Number)
    Print #intHandle, "Error source:" & IIf(pErrSrc <> "", pErrSrc, Err.Source)
    Print #intHandle, "Error description:" & IIf(pErrDesc <> "", pErrDesc, Err.Description)
    Err.Clear
    Print #intHandle, "Variable contents"
    'Print #intHandle, "Site=" & strSite
    'Print #intHandle, "Location=" & strBinLoc
    'Print #intHandle, "Item Number=" & strItemNo
    'Print #intHandle, "Asset=" & strAsset
    'Print #intHandle, "Serial number=" & strSerialNumber
    Print #intHandle, "TCPIP buffer"
    Print #intHandle, buffer
    Print #intHandle, vbCrLf
    If MDIForm1.dc.conDynamic.Errors.Count > 0 Then
        Print #intHandle, "Dynamic Connection Errors: " & MDIForm1.dc.conDynamic.Errors.Count
        For X = 0 To MDIForm1.dc.conDynamic.Errors.Count - 1
           Print #intHandle, MDIForm1.dc.conDynamic.Errors(X)
        Next
        MDIForm1.dc.conDynamic.Errors.Clear
        Print #intHandle, vbCrLf
    End If
    If MDIForm1.dc.conReadOnly.Errors.Count > 0 Then
        Print #intHandle, "ReadOnly Connection Errors: " & MDIForm1.dc.conReadOnly.Errors.Count
        For X = 0 To MDIForm1.dc.conReadOnly.Errors.Count - 1
           Print #intHandle, MDIForm1.dc.conReadOnly.Errors(X)
        Next
        MDIForm1.dc.conReadOnly.Errors.Clear
        Print #intHandle, vbCrLf
    End If
    Print #intHandle, "************************************************"
    Close #intHandle
    
    MDIForm1.StatusBar1.Panels(1).Text = "Last Error: " & Now
End Sub

Private Function GetAction() As String

    Select Case enAct
        Case eaOff
            GetAction = "None"
        'Case eaMoveAssetUpdate
        '    GetAction = "Move Asset Update"
        'Case eaAssetInventoryUpdate
         '   GetAction = "Asset Inventory Update"
        'Case Else
         '   GetAction = ""
    End Select
End Function

Private Function GetCurrentScreen() As String
    Select Case CurrentScreen
        Case scsplash
            GetCurrentScreen = "Splash"
        Case scLogin
            GetCurrentScreen = "Login"
        Case scMainMenu
            GetCurrentScreen = "Main Menu"
        Case scShipping                 'Enter Invoice Number
            GetCurrentScreen = "Shipping"
        Case screceiving1
            GetCurrentScreen = "Receiving1"
        Case screceivingLOT
            GetCurrentScreen = "ReceivingLot"
        Case scReceiving2
           GetCurrentScreen = "Receiving2"
        Case scReceiving3
            GetCurrentScreen = "Receiving3"
        Case scReceiving4
            GetCurrentScreen = "Receiving4"
        Case scReceiving5
            GetCurrentScreen = "Receiving5"
        Case scReceiving5b
            GetCurrentScreen = "Receiving5b"
        Case scReceiving4b              'HACCP
            GetCurrentScreen = "Receiving4b"
        Case scReceiving3b              'HACCP
            GetCurrentScreen = "Receiving3b"
        Case scHAC
            GetCurrentScreen = "Hac"
        Case scconsume1
            GetCurrentScreen = "Consume1"
        Case scconsume2
            GetCurrentScreen = "Consume2"
        Case scConsume3
            GetCurrentScreen = "Consume3"
        Case scRecipe
            GetCurrentScreen = "Recipe"
        Case scRecipe2
            GetCurrentScreen = "Recipe2"
        Case scRecipe3
            GetCurrentScreen = "Recipe3"
        Case scJobNumber
            GetCurrentScreen = "JobNumber"
        Case scConfirmation
            GetCurrentScreen = "Confirmation"
        Case scsuccess
            GetCurrentScreen = "Success"
        Case scFG1
            GetCurrentScreen = "FG1"
        Case scConLot
            GetCurrentScreen = "ConLot"
        Case scConShip
            GetCurrentScreen = "ConShip"
        Case scNoUser
            GetCurrentScreen = "NoUser"
       
        Case Else
            GetCurrentScreen = ""
    End Select


    
End Function


'*********************************************************************
'**                                                                 **
'**        Syngistic Scanner Application - Shipping Functions       **
'**        Last Update: 5-2-07                                      **
'**                                                                 **
'*********************************************************************

Private Sub ScreenShipping(ByRef buffer As String)

On Error GoTo Errorhandler

    Dim strRetKey As String
    Dim strBC As String
    ResetModuleVariables
    
If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 1, 1, "Input Invoice:"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 2, 50, "", "", ""
    Me.RFSApplication1.RFLabel 1, 3, "Scan label:"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 4, 50, "", "", ""
    Me.RFSApplication1.RFLabel 1, 5, "Number of Cases:"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 6, 50, "", "", ""
    Me.RFSApplication1.RFLabel 1, 7, "Number of Bottles:"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 8, 50, "", "", ""
Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
        Case RF_ENTER
        
            strBC = ParseBuffer(3, buffer)
            strBarcodeID = strBC
            InvoiceNum = ParseBuffer(2, buffer)
            Lot = Left(strBC, Len(strBC) - 14)  'jobid
            ProdCODE = Mid(strBC, Len(Lot) + 2, 10) 'upc
            ScanCount = ParseBuffer(4, buffer) 'cases
            vBottles = ParseBuffer(5, buffer) 'bottles
            CurrentScreen = scConShip
            
        Case RF_F5
            CurrentScreen = scMainMenu
    End Select
End If
    
Exit Sub
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description

End Sub

Private Sub screenlShipUpdate()
On Error GoTo Errorhandler

    CloseModuleRecordsets
    
    Set rsRecipe = New ADODB.Recordset
    
    rsRecipe.Open "tblSOHeader", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic
        
    rsRecipe.AddNew
    rsRecipe!InvoiceNum = InvoiceNum
    rsRecipe!Date = Date
    rsRecipe!shipped = True
    rsRecipe.Update
    rsRecipe.Close
    
    rsRecipe.Open "select SONum from tblSOHeader where invoicenum = '" & InvoiceNum & "'", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic
    Let vSONum = rsRecipe.Fields("sonum")
    rsRecipe.Close
    
    'Update the tblSODetail with new sonum
    rsRecipe.Open "select * from tblSODetail where invoicenum = '" & InvoiceNum & "'"
    rsRecipe.Fields("sonum") = vSONum
    rsRecipe.Update
    rsRecipe.Close
    
    
Errorhandler:
    LogError "screenlShipUpdate", Err.Number, Err.Source, Err.Description
End Sub

Private Sub ScreenConship(ByVal buffer As String)
On Error GoTo HandleError
    Dim strRetKey As String
    Dim X As Integer
    Dim rsRecords As ADODB.Recordset
    Dim myProdCost As Double
    Dim myLot As Long
    Dim myQty As Double
    Dim myProduct As String
    Dim myUnitsper As Integer
    
    Let myProduct = ProdCODE
    
    Let myLot = Lot
    
    Set rsRecords = New ADODB.Recordset
    Set rsRecipe = New ADODB.Recordset

If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 1, 1, "Enter to Confirm:"
    Me.RFSApplication1.RFLabel 1, 7, "F5 to exit"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 2, 0, "", "", ""
    Exit Sub
Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
        
        Case RF_ENTER
            rsRecords.Open "select * from _ProductsTable where UPC = '" & myProduct & "'", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic
            myProdCost = rsRecords.Fields("cost")
            myUnitsper = rsRecords.Fields("ANU")
            Let myQty = (CInt(ScanCount) * myUnitsper) + CInt(vBottles)
            
            rsRecipe.Open "tblSOdetail", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic
            rsRecipe.AddNew
            rsRecipe!Sonum = vSONum
            rsRecipe!InvoiceNum = InvoiceNum
            rsRecipe!BarcodeScanned = strBarcodeID
            rsRecipe!lotnum = Lot
            rsRecipe!Qty = myQty
            rsRecipe!productcode = ProdCODE
            rsRecipe.Update
            screenlShipUpdate
            CurrentScreen = scsuccess
                       
           X = InventoryTransaction(4, myLot, myProduct, myQty * -1, myProdCost, 2, CInt(myUnitsper))
           
        Case RF_F5
            CurrentScreen = scsplash
    End Select
End If

    Set rsRecords = Nothing
    Set rsRecipe = Nothing

Exit Sub

HandleError:
 LogError buffer, Err.Number, Err.Source, Err.Description

End Sub


Private Sub ScreenReceiving1(ByRef buffer As String)
    On Error GoTo Errorhandler
    
    Dim strPONUM As String
    Dim strRetKey As String
    counter = 0
    
    ResetModuleVariables
    
    If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 1, 1, "-Receiving Manager-"
    Me.RFSApplication1.RFLabel 1, 2, "Please Scan a PO:"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 3, 50, "", "", ""
    Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
      Case RF_ENTER
            strPO = ParseBuffer(2, buffer)
            numPO = ParseBuffer(2, buffer)
            CurrentScreen = scReceiving2
        Case RF_F5
            
            CurrentScreen = scMainMenu
            
    End Select
    End If
    
    Exit Sub
    
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description
    
End Sub

Private Sub ScreenReceiving2(ByRef buffer As String)
On Error GoTo Errorhandler

    Dim strRetKey As String
    Dim its As Integer 'Number of Products for a PO'
    Dim newPO As Integer
    Dim i As Integer
    Dim vArs As String
    newPO = strPO
    Set rsRaw = New ADODB.Recordset

'***************************strPO is POnum in the database.  The Datatype changed from a numer to a string*****************
rsRaw.Open "Select PoLineNum, Prod_Code, itemname, qty, unit from qryPOitemDesc where PO1 = '" & newPO & "'", MDIForm1.dc.conReadOnly, adOpenKeyset, adLockReadOnly

its = rsRaw.RecordCount
        Me.RFSApplication1.RFLabel 1, 1, "Ln#:Ut:Qty:Desc"
    For i = 1 To its
        Me.RFSApplication1.RFLabel 1, (i + 1), rsRaw!polinenum & ":" & rsRaw!Qty & ":" & rsRaw!unit & ":" & rsRaw!itemname
        rsRaw.MoveNext
        If rsRaw.EOF Then
            GoTo Condition
        End If
    Next i
Condition:
    If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 1, (i + 3), "Please Enter Line#:"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, (i + 4), 50, "", "", ""
    Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
      Case RF_ENTER
            strLine = ParseBuffer(2, buffer)
            CurrentScreen = screceivingLOT
        Case RF_F5
            CurrentScreen = scsplash
    End Select
    End If
CloseModuleRecordsets

Exit Sub

Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description

End Sub


Private Sub ScreenReceivingLOT(ByRef buffer As String)
On Error GoTo Errorhandler

    Dim strRetKey As String
    
'    Set rsRaw = New ADODB.Recordset
'    rsRaw.Open "Select * from qrypoitemdesc where PO1 = '" & strPO & "' and POLineNum = '" & strLine & "'", MDIForm1.dc.conReadOnly, adOpenKeyset, adLockReadOnly

If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 1, 1, "Vendor Lot:"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 2, 50, "", "", ""
Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
        Case RF_ENTER
            strVenLot = IIf(ParseBuffer(2, buffer) = "", strVenLot, ParseBuffer(2, buffer))
            CurrentScreen = scReceiving3
        Case RF_F5
            CurrentScreen = scsplash
    End Select
End If

CloseModuleRecordsets
Exit Sub
    
Errorhandler:
LogError buffer, Err.Number, Err.Source, Err.Description

End Sub

Private Sub ScreenReceiving3(ByRef buffer As String)
On Error GoTo Errorhandler

    Dim strRetKey As String
    Dim filterString As String

    Set rsRaw = New ADODB.Recordset
rsRaw.Open "Select PoLineNum, Prod_Code, itemname, qty, unit,priceperlb from qryPOitemDesc where PO1 = '" & strPO & "' and POLineNum = '" & strLine & "'", MDIForm1.dc.conReadOnly, adOpenKeyset, adLockReadOnly

strProdCODE = rsRaw!prod_code
strQty = rsRaw!Qty
dblLineValue = rsRaw!priceperlb

Me.RFSApplication1.RFLabel 1, 1, "P.O. Number='" & strPO & "'"
Me.RFSApplication1.RFLabel 1, 2, "Ln#:Qty:Ut:Desc"
Me.RFSApplication1.RFLabel 1, 3, rsRaw!polinenum & ":" & rsRaw!Qty & ":" & rsRaw!unit & ":" & rsRaw!itemname
Me.RFSApplication1.RFLabel 1, 5, "Qty Expected:" & rsRaw!Qty
Me.RFSApplication1.RFLabel 1, 6, "_______________________________"
Me.RFSApplication1.RFLabel 1, 7, "Qty Received:"

If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 8, 50, "", "", ""
Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
        Case RF_ENTER
            strRecAmt = IIf(ParseBuffer(2, buffer) = "", strRecAmt, ParseBuffer(2, buffer))
            CurrentScreen = scReceiving5
        Case RF_F5
            CurrentScreen = scsplash
    End Select
End If
Exit Sub

Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description

End Sub


Private Sub ScreenReceiving5(ByRef buffer As String)
On Error GoTo Errorhandler

    Dim strRetKey As String
    Dim Accept As String
    Dim blreCeived As Boolean
    Dim i As Integer
    Dim X As Integer
            
    'Opens tblRawNew table for editing in data.mdb
    Set rsRaw = New ADODB.Recordset
rsRaw.Open "tblReceivingHeader", MDIForm1.dc.conDynamic, adOpenKeyset, adLockOptimistic, adCmdTable

'Make Received Lot number
strLOTnum = strPO & strLine
numLOTnum = strPO & strLine
'new way
strLOTnum = strProdCODE
numLOTnum = strProdCODE
'Create BarcodeID for Raw Lot
strBarcodeID = Format(Year(Date), "00") & CDate2Julian(Date) & "-" & strLOTnum

wrongSel:
If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 1, 1, "Enter 1 to confirm:"
    Me.RFSApplication1.RFLabel 1, 2, GetLabel("lblAccept", rsRFSystemParameter!Language)
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 3, 2, "", "", ""
    Me.RFSApplication1.RFLabel 1, 4, GetLabel("lblEscUpOne", rsRFSystemParameter!Language)
    If counter > 1 Then
        Me.RFSApplication1.RFLabel 1, 6, "Please use '1' or '2'"
        counter = 0
    End If
    
Else
    counter = counter + 1
    If counter > 1 Then
        buffer = ""
        GoTo wrongSel
    End If
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
        Case RF_ENTER
            Accept = ParseBuffer(2, buffer)
            If Accept = "1" Then
                If rsRaw.BOF Or rsRaw.EOF Then
                GoTo BOFTIME
                End If
                rsRaw.MoveLast
                rsRaw.MoveFirst
BOFTIME:
                For i = 1 To rsRaw.RecordCount
                    If rsRaw.Fields("PO") = numPO Then
                        If rsRaw.Fields("POLineNum") = strLine Then
                            GoTo EXITNow
                        End If
                    End If
                    If i = rsRaw.RecordCount Then
                        If rsRaw.Fields("PO") = numPO Then
                            If rsRaw.Fields("POLineNum") = strLine Then
                                GoTo EXITNow
                            End If
                        End If
                    End If
                    rsRaw.MoveNext
                Next i
                rsRaw.AddNew
                rsRaw!PO = strPO
                rsRaw!receivedate = Date
                rsRaw!polinenum = strLine
                rsRaw!ProdCODE = strProdCODE
                blreCeived = True
                'rsRaw!received = blreCeived
                rsRaw.Update
                
EXITNow:
                'CurrentScreen = scReceiving5b ---this is empty so just run the function to add a new detail rec.
                                'usually it would be done in the  5b form
          Call AddRecDetailRecord  'adds the record in tblReceivingDetail that will be edited here.
X = InventoryTransaction(2, CInt(strProdCODE), CInt(strProdCODE), CDbl(strRecAmt), dblLineValue, 1)
                   CurrentScreen = scReceiving4b
                                                                
            Else
                If Accept <> "2" Then
                counter = counter + 1
                End If
                CurrentScreen = scReceiving3
            End If
        Case RF_F5
            CurrentScreen = scsplash
    End Select
End If

CloseModuleRecordsets

Exit Sub
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description

End Sub

Private Sub ScreenReceiving5b(ByRef buffer As String)

On Error GoTo Errorhandler

    Dim strRetKey As String
    Dim Accept As String
    
    'Opens tblreceivingdetail table for editing in data.mdb
    Set rsRaw = New ADODB.Recordset
rsRaw.Open "tblReceivingDetail", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic, adCmdTable


        rsRaw.AddNew
        rsRaw!Ponum = strPO
        rsRaw!lotnum = strLOTnum
        rsRaw!polinenum = strLine
        rsRaw!Qty = strRecAmt
        rsRaw!scannedbarcode = strBarcodeID
        rsRaw!venlot = strVenLot
        rsRaw.Update
    
        CurrentScreen = scReceiving4b
                    
CloseModuleRecordsets


Exit Sub
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description

End Sub

Private Sub AddRecDetailRecord()
On Error GoTo Errorhandler

    Dim strRetKey As String
    Dim Accept As String
    Dim newTag As Integer
    
    
    'Opens tblreceivingdetail table for editing in data.mdb
    Set rsRaw = New ADODB.Recordset
    rsRaw.Open "SELECT Max([tagnum]) AS nextTag FROM tblReceivingDetail;", MDIForm1.dc.conReadOnly, adOpenKeyset, adLockReadOnly
    Let newTag = rsRaw.Fields(0)
    newTag = newTag + 1
    
    rsRaw.Close
    
    rsRaw.Open "tblReceivingDetail", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic, adCmdTable

        rsRaw.AddNew
        rsRaw!Ponum = strPO
        rsRaw!lotnum = strLOTnum
        rsRaw!polinenum = strLine
        rsRaw!Qty = strRecAmt
        rsRaw!scannedbarcode = strBarcodeID & "-" & newTag
        rsRaw!venlot = strVenLot
        rsRaw.Update
        'CurrentScreen = scReceiving4b
                     
CloseModuleRecordsets
Exit Sub

Errorhandler:
    LogError "From function AddRecDetailRecord - called by Screen Receiving4B", Err.Number, Err.Source, Err.Description

End Sub

Private Sub ScreenReceiving4b(ByRef buffer As String)
On Error GoTo Errorhandler
    
    Dim strRetKey As String
    Dim received As Boolean
       
    Set rsRaw = New ADODB.Recordset
    rsRaw.Open "Select * from tblReceivingDetail where venlot = '" & strVenLot & "'", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic
    

    Me.RFSApplication1.RFLabel 1, 1, "1=Yes and 2=NO:"
    Me.RFSApplication1.RFLabel 1, 2, "Pests? "
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 3, 2, "", "", ""
    Me.RFSApplication1.RFLabel 1, 4, "Sealed? "
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 5, 2, "", "", ""
    Me.RFSApplication1.RFLabel 1, 6, "Damaged? "
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 7, 2, "", "", ""
    Me.RFSApplication1.RFLabel 1, 8, "Trailer Condition:"
    Me.RFSApplication1.RFLabel 1, 9, "1=good,2=Bad,3=Pickup"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 10, 2, "", "", ""
    Me.RFSApplication1.RFLabel 1, 11, "Temp?"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 12, 4, "", "", ""
    
    
If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5

Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
      
         Case RF_ENTER
            blPests = ParseBuffer(2, buffer)
            blSealed = ParseBuffer(3, buffer)
            blDamaged = ParseBuffer(4, buffer)
            strTrailCond = ParseBuffer(5, buffer)
            strTemp = ParseBuffer(6, buffer)
            
            '=======================================
            Select Case blPests
                Case "1"
                    blPests = "YES"
                    rsRaw!pests = blPests
                Case Else
                    blPests = "NO"
                    rsRaw!pests = blPests
            End Select
            '=======================================
            Select Case blDamaged
                Case "1"
                    blDamaged = "YES"
                    rsRaw!damaged = blDamaged
                Case Else
                    blDamaged = "NO"
                    rsRaw!damaged = blDamaged
            End Select
            '=======================================
            Select Case blSealed
                Case "1"
                    blSealed = "YES"
                    rsRaw!sealed = blSealed
                Case Else
                    blSealed = "No"
                    rsRaw!sealed = blSealed
            End Select
            '=======================================
            Select Case strTrailCond
                Case "1"
                    strTrailCond = "Good"
                    rsRaw!trailercond = strTrailCond
                Case "2"
                    strTrailCond = "Bad"
                    rsRaw!trailercond = strTrailCond
                Case "3"
                    strTrailCond = "Pickup"
                    rsRaw!trailercond = strTrailCond
                Case Else
                    strTrailCond = "NA"
                    rsRaw!trailercond = strTrailCond
             End Select
             '=======================================
             Select Case strTemp
                Case ""
                    strTemp = 999
                    rsRaw!temp = strTemp
                Case Else
                    rsRaw!temp = strTemp
            End Select
            '=======================================
            
            'Update the recordset
            rsRaw.Update
            CurrentScreen = scHAC
        Case RF_F5
            CurrentScreen = scsplash
    End Select
End If

CloseModuleRecordsets

Exit Sub
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description
End Sub

Private Sub ScreenHAC(ByVal buffer As String)

On Error GoTo Errorhandler
    
    Dim strRetKey As String
    Dim received As Boolean
    
    Set rsRaw = New ADODB.Recordset
    rsRaw.Open "Select * from tblReceivingDetail where venlot = '" & strVenLot & "'", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic
    

    Me.RFSApplication1.RFLabel 1, 2, "Receiver number:"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 3, 50, "", "", ""
    Me.RFSApplication1.RFLabel 1, 4, "PH level"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 5, 50, "", "", ""
    Me.RFSApplication1.RFLabel 1, 6, "BRIX"
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 7, 50, "", "", ""
    
    If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5

Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
      
        Case RF_ENTER
            strRECER = ParseBuffer(2, buffer)
            strPH = ParseBuffer(3, buffer)
            strBRIX = ParseBuffer(4, buffer)
            If strPH = "" Then
                strPH = 0
            End If
            If strBRIX = "" Then
                strBRIX = 0
            End If
            rsRaw!RECER = strRECER
            rsRaw!PH = strPH
            rsRaw!BRIX = strBRIX
            rsRaw.Update
            CurrentScreen = scReceiving3b
        Case RF_F5
            CurrentScreen = scsplash
    End Select
    
End If
CloseModuleRecordsets

Exit Sub
Errorhandler:

    LogError buffer, Err.Number, Err.Source, Err.Description

End Sub
Private Sub ScreenReceiving3b(ByVal buffer As String)

    Dim strRetKey As String
    Dim its As Integer
    Dim i As Integer
    
    
    Set rsRaw = New ADODB.Recordset
    rsRaw.Open "Select * from qryPOREC where PO1 = '" & strPO & "'", conLocal, adOpenKeyset, adLockReadOnly
its = 1
its = rsRaw.RecordCount

    Me.RFSApplication1.RFLabel 1, 1, "PO:POLn:qty:QtyRec"
    For i = 2 To (its + 1)
    Me.RFSApplication1.RFLabel 1, i, rsRaw!PO1 & ":" & rsRaw!polinenum & ":" & rsRaw!prod_code & ":" & rsRaw!POQTY & ":" & rsRaw!recqty
    rsRaw.MoveNext
    Me.RFSApplication1.RFBeep
    Me.RFSApplication1.RFDisplay
    If rsRaw.EOF = True Then
        GoTo brEak
    End If
    Next i
brEak:
    Me.RFSApplication1.RFLabel 1, 7, "Enter=Main Menu,F1=Receive"
    'buffer = RF_ENTER
    Me.RFSApplication1.RFDisplay
    strRetKey = ParseBuffer(1, buffer)
If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5 & RF_F1
Else
'    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
        Case RF_ENTER
            CurrentScreen = scMainMenu
        Case RF_F5
            CurrentScreen = scsplash
        Case RF_F1
            CurrentScreen = screceiving1
        Case Else
            CurrentScreen = scMainMenu
    End Select
End If
CloseModuleRecordsets
Exit Sub

End Sub

Private Sub ScreenRecipe(ByRef buffer As String)
On Error GoTo Errorhandler
    Dim rsUpdateNewJob As ADODB.Recordset
    Dim strRetKey As String
    Dim i As Integer
    Dim its As Integer
  
    Set rsRecipe = New ADODB.Recordset
    
    rsRecipe.Open "tblrecipeh", MDIForm1.dc.conReadOnly, adOpenKeyset, adLockReadOnly

    its = rsRecipe.RecordCount
        
        Me.RFSApplication1.RFLabel 1, 1, "Recipe List:"
        rsRecipe.MoveFirst
        For i = 1 To its
            Me.RFSApplication1.RFLabel 1, (i + 1), rsRecipe!RecipeNum & ":" & rsRecipe!recipeName
            rsRecipe.MoveNext
        Next i
        Me.RFSApplication1.RFLabel 1, (i + 2), "Enter Recipe Num:"
        
        Me.RFSApplication1.RFScannerKeyboardTextBox 1, (i + 3), 50, "", "", ""
        
If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
        Case RF_ENTER
            strRecNum = ParseBuffer(2, buffer)  'Replaced with integer
            RecipeNum = ParseBuffer(2, buffer)
            'CurrentScreen = scRecipe2
            
            Set rsUpdateNewJob = New ADODB.Recordset
                rsUpdateNewJob.Open "select * from tbljobh where jobid = " & intJob, conLocal, adOpenForwardOnly, adLockOptimistic
                rsUpdateNewJob!recipeid = RecipeNum
                rsUpdateNewJob.Update
                rsUpdateNewJob.Close
                        
            CurrentScreen = scconsume1
        Case RF_F5
            CurrentScreen = scconsume1
    End Select
End If

Exit Sub

Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description

End Sub

Private Sub ScreenRecipe2(ByRef buffer As String)
On Error GoTo Errorhandler

  
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description
End Sub

Private Sub Screenrecipe3(ByRef buffer As String)
On Error GoTo Errorhandler

    Dim strRetKey As String
ResetModuleVariables
CloseModuleRecordsets

    Set rsRecipe = New ADODB.Recordset
rsRecipe.Open "tblJobRaw", conLocal, adOpenDynamic, adLockOptimistic

    If buffer = "" Then
       
        Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5 & RF_F1
        Me.RFSApplication1.RFLabel 1, 1, "Scan Ingredient:"
        Me.RFSApplication1.RFScannerTextBox 1, 2, 50, "", "", ""
        Me.RFSApplication1.RFLabel 1, 3, "Enter amount used:"
        Me.RFSApplication1.RFScannerKeyboardTextBox 1, 4, 50, "", "", ""
        Me.RFSApplication1.RFLabel 1, 7, "F1 = Continue"
        Me.RFSApplication1.RFLabel 1, 8, "F5 = Back"

        Exit Sub
    
    Else

        strRetKey = ParseBuffer(1, buffer)
        
        Select Case strRetKey
            Case RF_ENTER
                    ing = ParseBuffer(2, buffer)
                    Con = ParseBuffer(3, buffer)
                    
            rsRecipe.AddNew
            rsRecipe!RawTagNum = strRecNum
            rsRecipe!Date = Date
            JOBy = rsRecipe!id
            rsRecipe!Jobid = JOBy
            rsRecipe.Update

            Case RF_F1
                CurrentScreen = scConfirmation
                Exit Sub

            Case RF_F5
                    'CurrentScreen = scRecipe2
                CurrentScreen = scconsume2
                Exit Sub
        End Select
    End If
    
buffer = ""

Exit Sub

Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description
End Sub

Private Sub ScreenConfirmAtion(ByRef buffer As String)
        
End Sub

Private Sub ScreenJobNumber(ByRef buffer As String)
On Error GoTo Errorhandler
    Dim strRetKey As String

ResetModuleVariables
CloseModuleRecordsets

    Set rsRecipe = New ADODB.Recordset
rsRecipe.Open "tblJobRaw", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic

If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 2, 1, "Job number Below"
    rsRecipe.MoveLast
    Me.RFSApplication1.RFLabel 2, 2, rsRecipe!id
    Me.RFSApplication1.RFLabel 2, 3, "Enter to Cont."
    Exit Sub
Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case RF_ENTER
        Case RF_ENTER
            'FinalUpdater
        Case RF_F5
            CurrentScreen = scsplash
    End Select
    CloseModuleRecordsets
        
    Exit Sub
End If
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description
        
End Sub


Private Sub ScreenSuccess(ByRef buffer As String)
Dim strRetKey As String

If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER
    Me.RFSApplication1.RFLabel 1, 1, "JOB SUCCESSFUL!"
    Me.RFSApplication1.RFLabel 1, 6, "Press Any Key."
    Me.RFSApplication1.RFScannerTextBox 1, 2, 0, "", "", ""
    Exit Sub
Else
    strRetKey = ParseBuffer(1, buffer)
    CurrentScreen = scMainMenu
End If
Y = 0
CloseVars
CloseModuleRecordsets

End Sub

Private Sub ScreenFG1(ByRef buffer As String)
On Error GoTo Errorhandler
    
    Dim strRetKey As String
    Dim strBC As String
    Dim strCase As String
    Dim strBottles As String
    
If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_F5 & RF_ENTER
    Me.RFSApplication1.RFLabel 1, 1, "Scan Case:"
    Me.RFSApplication1.RFScannerTextBox 1, 2, 50, "", "", ""
    Me.RFSApplication1.RFLabel 1, 3, "Cases:"
    Me.RFSApplication1.RFScannerTextBox 1, 4, 50, "", "", ""
    Me.RFSApplication1.RFLabel 1, 5, "Extra Bottles:"
    Me.RFSApplication1.RFScannerTextBox 1, 6, 50, "", "", ""
    Me.RFSApplication1.RFLabel 1, 8, "F5 to exit"
    Exit Sub
Else
    strRetKey = ParseBuffer(1, buffer)
        If ParseBuffer(2, buffer) = "" Then
            CurrentScreen = scMainMenu
            Exit Sub
        End If
    Select Case strRetKey
        Case RF_ENTER   'Parse the scanned barcode UPC is always 10 (doesn't include the 7) digits and UOM is always 3 digits
            strBC = ParseBuffer(2, buffer)
            strBotnCase = Right(strBC, 3)
            strFGCaseLot = Left(strBC, Len(strBC) - 14)
            strUPC = Mid(strBC, Len(Left(strBC, Len(strBC) - 14)) + 2, 10)
            strCase = ParseBuffer(3, buffer)
            strBottles = ParseBuffer(4, buffer)
            
            Let strCaseNum = CInt(strBottles) + CInt(strCase) * CInt(strBotnCase)

            CurrentScreen = scConLot
        Case RF_F5
            CurrentScreen = scMainMenu
    End Select
End If

Exit Sub
               
Errorhandler:
 LogError buffer, Err.Number, Err.Source, Err.Description


End Sub

Private Sub ScreenConLot(ByRef buffer As String)
On Error GoTo Errorhandler

    Dim strRetKey As String
    Dim dblVal As Double
    Dim vUnitsper As String
    Dim rsValue As ADODB.Recordset
    Dim X As Integer
    
    Set rsValue = New ADODB.Recordset
    Set rsRecipe = New ADODB.Recordset
                
If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 2, 2, "Enter to Confirm."
    Me.RFSApplication1.RFLabel 2, 3, "OR,"
    Me.RFSApplication1.RFLabel 2, 4, "F5 to cancel."
    Me.RFSApplication1.RFScannerKeyboardTextBox 1, 1, 0, "", "", ""
    Exit Sub
Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
        Case RF_ENTER
                rsValue.Open "select cost,anu from _productsTable where UPC = '" & strUPC & "'", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic
                    rsValue.MoveFirst
                If rsValue.EOF = True Then
                    dblVal = 0
                    vUnitsper = 1
                Else
                    dblVal = rsValue.Fields(0)
                    vUnitsper = rsValue.Fields(1)
                End If
                
                 X = InventoryTransaction(5, CInt(strFGCaseLot), strUPC, CInt(strCaseNum), dblVal, 2, vUnitsper)
            
'            rsRecipe.Open "tblJobFG", MDIForm1.dc.conDynamic, adOpenDynamic, adLockOptimistic
'            rsRecipe.AddNew
'            rsRecipe!Jobid = CInt(strFGCaseLot)
'            rsRecipe!qty = CInt(strCaseNum)
'            rsRecipe!UnitsPer = CInt(strBotnCase)
'            rsRecipe!OnHand = CInt(strCaseNum)
'            rsRecipe!UPC = strUPC
'            rsRecipe!valueper = dblVal
'            rsRecipe.Update
            CurrentScreen = scsuccess
        Case RF_F5
            CurrentScreen = scFG1
    End Select
End If

    rsValue.Close
    CloseModuleRecordsets
        
   Exit Sub
Errorhandler:
Select Case Err.Number
    Case 3021
        Resume Next
    Case Else
 LogError buffer, Err.Number, Err.Source, Err.Description
End Select

End Sub

'======================================================================================
'New consume
Private Sub ScreenConsume1(ByRef buffer As String)  'get job
On Error GoTo Errorhandler

    Dim sqlstr As String
    Dim its As Integer
    Dim i As Integer

CloseModuleRecordsets

    Set rsJob = New ADODB.Recordset
sqlstr = "SELECT JobID, JobDate, RecipeID, RecipeName FROM qryJobs  WHERE (((JobDate)= #" & Format(Now(), "mm/dd/yyyy") & "#))"
 
rsJob.Open sqlstr, conLocal, adOpenKeyset, adLockOptimistic
              
i = 1

If rsJob.BOF = True Then
    If rsJob.EOF = True Then
    Me.RFSApplication1.RFLabel 1, 1, "No Jobs Scheduled for Today"
            GoTo NoJobs
    End If
Else
    If rsJob.EOF = True Then
        If rsJob.BOF = True Then
            Me.RFSApplication1.RFLabel 1, 1, "No Jobs Scheduled for Today"
            GoTo NoJobs
        End If
    End If
End If

rsJob.MoveLast
rsJob.MoveFirst
'------------

its = rsJob.RecordCount
        
        Me.RFSApplication1.RFLabel 1, 1, "Job List:"
        
        For i = 1 To its
            Me.RFSApplication1.RFLabel 1, (i + 1), rsJob!Jobid & " :  " & rsJob!recipeName
            rsJob.MoveNext
        Next i
NoJobs: 'goes here if there are no jobs to setup

        Me.RFSApplication1.RFLabel 1, (i + 1), "0 :  ---- New Job ----          "
        Me.RFSApplication1.RFLabel 1, (i + 2), "Select Job Num: "
        
        Me.RFSApplication1.RFScannerKeyboardTextBox 16, (i + 2), 50, "", "", ""
      
      Me.RFSApplication1.RFDisplay
If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 1, (i + 3), "Enter-Continue,F5-Back."
    Me.RFSApplication1.RFScannerKeyboardTextBox 16, (i + 3), 0, "", "", ""
    
Else
sqlstr = ParseBuffer(1, buffer)
    Select Case sqlstr
        Case "ENTER"
            strRecNum = ParseBuffer(2, buffer)  'Replaced with integer
            If strRecNum = "0" Then
                'make new job
                    Dim rsNewJob As New ADODB.Recordset
                        rsNewJob.Open "select * from tblJobH", conLocal, adOpenDynamic, adLockOptimistic
                            rsNewJob.AddNew
                            rsNewJob!newrec = "newrec"
                            rsNewJob!JobDate = Date
                            rsNewJob.Update
                            rsNewJob.Close
                     
                        rsNewJob.Open "select * from tbljobh where newrec = 'newrec'", conLocal, adOpenDynamic, adLockOptimistic
                        Let intJob = rsNewJob!Jobid
                        rsNewJob!newrec = ""
                        rsNewJob.Update
                        rsNewJob.Close
                        'select new recipe for job
                        CurrentScreen = scRecipe
                             
                Else:
                'strRecNum = ParseBuffer(2, buffer)
                    If strRecNum = "" Then
        
                        Exit Sub
                    Else
                        Dim rsFindRecipe As New ADODB.Recordset
                        Let intJob = CInt(strRecNum)
                        rsFindRecipe.Open "Select recipeid from tbljobh where jobid = " & intJob, conLocal, adOpenDynamic
                        rsFindRecipe.MoveFirst
                        Let RecipeNum = rsFindRecipe.Fields(0)
                        
                        CurrentScreen = scconsume2
                    End If

               End If
        Case "RF_F5"
            CurrentScreen = scMainMenu
        Case "F5"
            CurrentScreen = scMainMenu
    End Select
End If

Exit Sub
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description

End Sub


Private Sub ScreenConsume2(ByRef buffer As String) ' show recipe and allow consume
On Error GoTo Errorhandler

    Dim strRetKey As String
    Dim i As Integer
    Dim its As Integer
    
    Dim sqlstr As String
ResetModuleVariables
CloseModuleRecordsets
'strRecNum = ParseBuffer(2, buffer)

Set rsRecipe = New ADODB.Recordset
sqlstr = "SELECT tblRecipeD.RecipeNum as RecNum, tblRecipeH.RecipeName as RecDesc, tblRecipeH.Active_Flag, tblRecipeH.Notes, " & _
    "[_MaterialsTable].ItemName, tblRecipeD.Qty" & _
    " FROM tblRecipeH INNER JOIN (tblRecipeD INNER JOIN _MaterialsTable ON tblRecipeD.IngredientID = " & _
    " [_MaterialsTable].ItemID) ON tblRecipeH.RecipeNum = tblRecipeD.RecipeNum where tblRecipeH.recipeNum = " & (RecipeNum)
    'Debug.Print sqlstr
    rsRecipe.Open sqlstr, conLocal, adOpenStatic, adLockReadOnly
    
'Check to see if we have records===============
If rsRecipe.BOF = True Then
    If rsRecipe.EOF = True Then
        Exit Sub
    End If
Else
    If rsRecipe.EOF = True Then
        If rsRecipe.BOF = True Then
            Exit Sub
        End If
    End If
End If
'End check =========================================

rsRecipe.MoveLast
rsRecipe.MoveFirst
recnamE = rsRecipe!recdesc
strRecNum = rsRecipe!RecNum

If buffer = "" Then
    Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5
    Me.RFSApplication1.RFLabel 1, 1, "Your Current Recipe:"
    Me.RFSApplication1.RFLabel 2, 2, recnamE
    Me.RFSApplication1.RFLabel 2, 3, "********************"
    
    its = rsRecipe.RecordCount
    
     For i = 1 To its
            Me.RFSApplication1.RFLabel 2, (i + 3), rsRecipe!itemname
            rsRecipe.MoveNext
     Next i
    Me.RFSApplication1.RFScannerKeyboardTextBox 2, (i + 3), 0, "", "", ""
    Me.RFSApplication1.RFDisplay
Else
    strRetKey = ParseBuffer(1, buffer)
    Select Case strRetKey
        Case RF_ENTER
            CurrentScreen = scConsume3
        Case RF_F5
            CurrentScreen = scconsume1
    End Select
End If
CloseModuleRecordsets
CloseVars

Exit Sub
   
Errorhandler:
    LogError buffer, Err.Number, Err.Source, Err.Description

End Sub

Private Sub ScreenConsume3(ByRef buffer As String)
On Error GoTo Errorhandler

    Dim strRetKey As String
    Dim vSuccess As Integer
    Dim vInvValue As Double
    Dim vtagNum As String
    Dim rsInvLot As ADODB.Recordset
    
    ResetModuleVariables
    CloseModuleRecordsets

    Set rsRecipe = New ADODB.Recordset
    rsRecipe.Open "tblJobRaw", conLocal, adOpenDynamic, adLockOptimistic

    If buffer = "" Then
        Me.RFSApplication1.RFTerminationKeys RF_ENTER & RF_F5 & RF_F1
        Me.RFSApplication1.RFLabel 1, 1, "Scan Ingredient:"
        Me.RFSApplication1.RFScannerTextBox 1, 2, 50, "", "", ""
        Me.RFSApplication1.RFLabel 1, 3, "Enter amount used:"
        Me.RFSApplication1.RFScannerKeyboardTextBox 1, 4, 50, "", "", ""
        Me.RFSApplication1.RFLabel 1, 5, "Vendor Lot:"
        Me.RFSApplication1.RFScannerKeyboardTextBox 1, 6, 50, "", "", ""
        Me.RFSApplication1.RFLabel 1, 7, "Enter-Cont.,F5-Back"
        Me.RFSApplication1.RFLabel 1, 8, "F1 = Main Menu"
        Me.RFSApplication1.RFDisplay
        Exit Sub
    
    Else

        strRetKey = ParseBuffer(1, buffer)
        
        Select Case strRetKey
            Case RF_ENTER
            If ParseBuffer(2, buffer) <> "" Then
                vtagNum = ParseBuffer(2, buffer)  'this is the received item tag number
                
                'must find inventory lot---this uses the new tag method
                'if not found it will error with err.num 3021 and goto findlot2 --2nd method the old way.
                Set rsInvLot = New ADODB.Recordset
                rsInvLot.Open "SELECT tblInventory.Lot" & _
                " FROM tblReceivingDetail INNER JOIN tblInventory ON tblReceivingDetail.LotNum = tblInventory.Lot " & _
                " WHERE (((tblReceivingDetail.TagNum)=" & vtagNum & "));", conLocal, adOpenDynamic, adLockOptimistic
                Let ing = rsInvLot.Fields(0)

            End If
            
FindLot:
              
            If ParseBuffer(3, buffer) <> "" Then
                Con = ParseBuffer(3, buffer)
            End If
                    vnd = ParseBuffer(4, buffer)
                    Select Case ing
                     Case 0
                            CurrentScreen = scConsume3
                            Exit Sub
                        Case Else
                            Select Case Con
                                Case 0
                                    CurrentScreen = scConsume3
                                    Exit Sub
                            Case Else
                                Let vInvValue = getInventoryValue(ing)
                                
                                rsRecipe.AddNew
                                rsRecipe!RawTagNum = ing
                                rsRecipe!Date = Date
                                rsRecipe!Jobid = intJob
                                rsRecipe!vendorlot = vnd
                                rsRecipe!User = strUserName
                                rsRecipe!Qty = Con
                                rsRecipe!costper = vInvValue
                                rsRecipe.Update
                                
                                vSuccess = InventoryTransaction(3, CInt(ing), CStr(ing), Con * -1, (vInvValue) * -1, 1)
                                If vSuccess = 1 Then
                                    'good
                                Else
                                    'bad
                                
                                End If
                        End Select
                    End Select
                                        
            Case RF_F1  'do the update if they entered data then go to consume1 screen
                    If ParseBuffer(2, buffer) <> "" Then
                ing = ParseBuffer(2, buffer)
            End If
            If ParseBuffer(3, buffer) <> "" Then
                Con = ParseBuffer(3, buffer)
            End If
                    vnd = ParseBuffer(4, buffer)
                    Select Case ing
                     Case 0
                            CurrentScreen = scMainMenu
                            Exit Sub
                        Case Else
                            Select Case Con
                                Case 0
                                    CurrentScreen = scMainMenu
                                    Exit Sub
                            Case Else
                            Let vInvValue = getInventoryValue(ing)
                                rsRecipe.AddNew
                                rsRecipe!RawTagNum = ing
                                rsRecipe!Date = Date
                                rsRecipe!Jobid = intJob
                                rsRecipe!vendorlot = vnd
                                rsRecipe!User = strUserName
                                rsRecipe!Qty = Con
                                rsRecipe!costper = vInvValue
                                rsRecipe.Update
                                
                                vSuccess = InventoryTransaction(3, CInt(ing), CStr(ing), Con * -1, (vInvValue) * -1, 1)
                                If vSuccess > 0 Then
                                    'good
                                Else
                                    'bad
                                
                                End If
                        End Select
                    End Select
                CurrentScreen = scMainMenu
               
                Exit Sub

            Case RF_F5  'ESC and exit to previous screen - no update done
                    
                CurrentScreen = scconsume2
                Exit Sub
        End Select
    End If
    
buffer = ""

Exit Sub
FindLot2:
Set rsInvLot = New ADODB.Recordset
                rsInvLot.Open "SELECT tblInventory.Lot" & _
                " FROM tblReceivingDetail INNER JOIN tblInventory ON tblReceivingDetail.tagnum = tblInventory.Lot " & _
                " WHERE (((tblReceivingDetail.lotnum)=" & vtagNum & "));", conLocal, adOpenDynamic, adLockOptimistic
            
            Let ing = rsInvLot.Fields(0)
GoTo FindLot

Errorhandler:
Select Case Err.Number
Case 3021
             GoTo FindLot2
Case Else
    LogError buffer, Err.Number, Err.Source, Err.Description
    
End Select
End Sub


